Introducción y preproceso de los datos

En esta práctica lo que se va a analizar es un conjunto de datos proveniente de un parque de atracciones de Wisconsin en el que los datos están recogidos a modo de encuesta y se pretende conocer más sobre la tipología y características de los clientes.

Antes que nada, se comprueba si los paquetes a emplear están correctamente cargados

comprobar <- function(pkg){
    new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
    if (length(new.pkg)) 
        install.packages(new.pkg, dependencies = TRUE)
    sapply(pkg, require, character.only = TRUE)
}
paquetes<-c("tidyverse","factoextra","FactoMineR","plfm","cluster",
            "ggplot2","VIM","mice","corrplot","psych","Hmisc",
            "NbClust","anacor","ca","gplots","naniar","missMDA","gmodels",
            "scales","descr")
comprobar(paquetes)
##  tidyverse factoextra FactoMineR       plfm    cluster    ggplot2        VIM 
##       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE 
##       mice   corrplot      psych      Hmisc    NbClust     anacor         ca 
##       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE 
##     gplots     naniar    missMDA    gmodels     scales      descr 
##       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE

A continuación, descargamos los datos (se puede emplear choose.file() pero en markdown no funciona) en el directorio de trabajo que vamos a usar. A su vez, establecemos que el nombre de las filas sea el ID del cliente para más comodidad.

setwd("C:/Users/Diego/Desktop/Introduction to data mining/TRabajo_final_individual_2")
datos<-read.csv("wisconsin_dells.csv",row.names = 1)

Explorando los datos en Excel, se comprueba que es un conjunto de datos obtenido mediante encuesta pues la totalidad de las variables son o binarias o para indicar frecuencia por lo que el modo más adecuado de obtener información del mismo va a ser usando mapas perceptuales y análisis de correspondencia.

Como siempre, comviene echar un vistazo general a los datos para comprobar observaciones faltantes o características generales

glimpse(datos)
## Rows: 1,698
## Columns: 42
## $ nnights        <chr> "3", "3", "4+", "3", "4+", "0", "1", "4+", "0", "3",...
## $ nadults        <chr> "2", "4", "2", "1", "5+", "2", "2", "5+", "2", "2", ...
## $ nchildren      <chr> "3", "5+", "2", "1", "5+", "4", "4", "2", "No kids",...
## $ planning       <chr> "This Month", "One Month or More Ago", "One Month or...
## $ sex            <chr> "Female", "Male", "Male", "Female", "Female", "Male"...
## $ age            <chr> "35-44", "35-44", "35-44", "35-44", "35-44", "35-44"...
## $ education      <chr> "HS Grad or Less", "College Grad", "College Grad", "...
## $ income         <chr> "Lower Income", "", "Lower Income", "Lower Income", ...
## $ region         <chr> "Other", "Minneapolis/StPaul", "Chicago", "Chicago",...
## $ shopping       <chr> "YES", "YES", "YES", "YES", "YES", "YES", "YES", "YE...
## $ antiquing      <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "YES...
## $ scenery        <chr> "YES", "YES", "YES", "YES", "YES", "NO", "NO", "YES"...
## $ eatfine        <chr> "YES", "NO", "NO", "NO", "NO", "NO", "YES", "NO", "Y...
## $ eatcasual      <chr> "YES", "YES", "YES", "YES", "YES", "NO", "NO", "YES"...
## $ eatfamstyle    <chr> "YES", "YES", "NO", "YES", "YES", "NO", "YES", "YES"...
## $ eatfastfood    <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ museums        <chr> "NO", "YES", "NO", "YES", "YES", "NO", "YES", "YES",...
## $ indoorpool     <chr> "YES", "YES", "NO", "YES", "NO", "NO", "YES", "YES",...
## $ outdoorpool    <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ hiking         <chr> "NO", "NO", "NO", "NO", "YES", "NO", "NO", "NO", "NO...
## $ gambling       <chr> "YES", "NO", "NO", "NO", "YES", "NO", "NO", "NO", "N...
## $ boatswim       <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ fishing        <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "NO", "NO...
## $ golfing        <chr> "NO", "NO", "YES", "YES", "YES", "NO", "NO", "NO", "...
## $ boattours      <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ rideducks      <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ amusepark      <chr> "YES", "NO", "YES", "YES", "YES", "NO", "YES", "YES"...
## $ minigolf       <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ gocarting      <chr> "YES", "YES", "YES", "YES", "YES", "YES", "YES", "YE...
## $ waterpark      <chr> "YES", "NO", "YES", "YES", "YES", "NO", "YES", "YES"...
## $ circusworld    <chr> "NO", "NO", "NO", "YES", "YES", "NO", "NO", "NO", "N...
## $ tbskishow      <chr> "YES", "YES", "YES", "NO", "NO", "NO", "NO", "NO", "...
## $ helicopter     <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...
## $ horseride      <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "YES", "N...
## $ standrock      <chr> "NO", "YES", "YES", "NO", "YES", "NO", "NO", "NO", "...
## $ outattract     <chr> "NO", "YES", "YES", "YES", "YES", "NO", "NO", "YES",...
## $ nearbyattract  <chr> "NO", "YES", "YES", "YES", "NO", "NO", "NO", "YES", ...
## $ movietheater   <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...
## $ concerttheater <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "NO", "NO...
## $ barpubdance    <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "YES", "YE...
## $ shopbroadway   <chr> "YES", "NO", "YES", "NO", "YES", "NO", "NO", "YES", ...
## $ bungeejumping  <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...
colSums(is.na(datos))
##        nnights        nadults      nchildren       planning            sex 
##              0              0              0              0              0 
##            age      education         income         region       shopping 
##              0              0              0              0              0 
##      antiquing        scenery        eatfine      eatcasual    eatfamstyle 
##              0              0              0              0              0 
##    eatfastfood        museums     indoorpool    outdoorpool         hiking 
##              0              0              0              0              0 
##       gambling       boatswim        fishing        golfing      boattours 
##              0              0              0              0              0 
##      rideducks      amusepark       minigolf      gocarting      waterpark 
##              0              0              0              0              0 
##    circusworld      tbskishow     helicopter      horseride      standrock 
##              0              0              0              0              0 
##     outattract  nearbyattract   movietheater concerttheater    barpubdance 
##              0              0              0              0              0 
##   shopbroadway  bungeejumping 
##              0              0
apply(datos, 2, range)
##      nnights nadults nchildren planning                sex      age    
## [1,] "0"     "1"     "1"       "One Month or More Ago" "Female" ""     
## [2,] "4+"    "5+"    "No kids" "This Week"             "Male"   "LT 25"
##      education      income         region            shopping antiquing scenery
## [1,] ""             ""             ""                "NO"     "NO"      "NO"   
## [2,] "Some College" "Upper Income" "Other Wisconsin" "YES"    "YES"     "YES"  
##      eatfine eatcasual eatfamstyle eatfastfood museums indoorpool outdoorpool
## [1,] "NO"    "NO"      "NO"        "NO"        "NO"    "NO"       "NO"       
## [2,] "YES"   "YES"     "YES"       "YES"       "YES"   "YES"      "YES"      
##      hiking gambling boatswim fishing golfing boattours rideducks amusepark
## [1,] "NO"   "NO"     "NO"     "NO"    "NO"    "NO"      "NO"      "NO"     
## [2,] "YES"  "YES"    "YES"    "YES"   "YES"   "YES"     "YES"     "YES"    
##      minigolf gocarting waterpark circusworld tbskishow helicopter horseride
## [1,] "NO"     "NO"      "NO"      "NO"        "NO"      "NO"       "NO"     
## [2,] "YES"    "YES"     "YES"     "YES"       "YES"     "YES"      "YES"    
##      standrock outattract nearbyattract movietheater concerttheater barpubdance
## [1,] "NO"      "NO"       "NO"          "NO"         "NO"           "NO"       
## [2,] "YES"     "YES"      "YES"         "YES"        "YES"          "YES"      
##      shopbroadway bungeejumping
## [1,] "NO"         "NO"         
## [2,] "YES"        "YES"

Todas las variables son string porque, aunque hay algunas discretas, poseen caracteres comoel signo más para indicar un valor superior a las posibilidades dadas. Si intentamos ver cuántos datos faltantes hay considerando NA el resultado es que no existe ninguno pero viendo, por ejemplo la variable income

head(datos$income,5)
## [1] "Lower Income" ""             "Lower Income" "Lower Income" ""

Vemos que hay casillas vacías que bien puede deberse a que el cliente se negó a facilitar la información o simplemente se ha perdido. Estos datos, para un tratamiento más claro de los mismos es mejor sustituirlos por NA así que procedemos a ello.

datos<-mutate_all(datos, list(~na_if(.,"")))

Y ya sí que se pueden emplear paquetes anteriores para visualizar cómo se distribuyen estos datos faltantes

plot_NA <- aggr(datos, col=c('lightblue','red'), numbers=TRUE,
                  sortVars=TRUE, labels=names(datos),
                  cex.axis=.3,
                  gap=3, ylab=c("Histogram of missing data","Pattern"))

## 
##  Variables sorted by number of missings: 
##        Variable       Count
##          income 0.157243816
##          region 0.022968198
##       education 0.011778563
##             age 0.005889282
##         nnights 0.000000000
##         nadults 0.000000000
##       nchildren 0.000000000
##        planning 0.000000000
##             sex 0.000000000
##        shopping 0.000000000
##       antiquing 0.000000000
##         scenery 0.000000000
##         eatfine 0.000000000
##       eatcasual 0.000000000
##     eatfamstyle 0.000000000
##     eatfastfood 0.000000000
##         museums 0.000000000
##      indoorpool 0.000000000
##     outdoorpool 0.000000000
##          hiking 0.000000000
##        gambling 0.000000000
##        boatswim 0.000000000
##         fishing 0.000000000
##         golfing 0.000000000
##       boattours 0.000000000
##       rideducks 0.000000000
##       amusepark 0.000000000
##        minigolf 0.000000000
##       gocarting 0.000000000
##       waterpark 0.000000000
##     circusworld 0.000000000
##       tbskishow 0.000000000
##      helicopter 0.000000000
##       horseride 0.000000000
##       standrock 0.000000000
##      outattract 0.000000000
##   nearbyattract 0.000000000
##    movietheater 0.000000000
##  concerttheater 0.000000000
##     barpubdance 0.000000000
##    shopbroadway 0.000000000
##   bungeejumping 0.000000000

El resultado es que el 82% de las observaciones no contienen NA siendo la variable que más posee income. Otra alternativa muy buena a ver estos datos faltantes es usando la librería naniar que posee múltiples funciones para ello

gg_miss_var(datos)

Este gráfico es muy sencillo y enseña que sólo las variables income, education, region y age poseen NA

gg_miss_upset(datos)

Este es más complejo y a parte de mostrar NA, muestra intersecciones entre variables calificadas de esa misma manera. Por ejemplo, hay 5 observaciones en las que age, education e income tienen NA. El resto de gráfico es interpretable de manera análoga a ello.

Podríamos considerar la eliminación de estas observaciones pero la proporción de datos faltantes (11%) es muy elevada así que los imputamos usando la función imputeMCA del paquete missMCA que introduce estos NA mediante Análisis de Correspondencia Múltiple.

Antes de hacerlo, convertimos esas variables en factores para que resulte más rápida la elección de posibles valores (posteriormente es más conveniente convertir todas las variables a factor)

datos$age<-as.factor(datos$age)
datos$income<-as.factor(datos$income)
datos$region<-as.factor(datos$region)
datos$education<-as.factor(datos$education)
datos_completos<-imputeMCA(datos)
datos_completos<-datos_completos$completeObs

Comprobamos si ya no hay ninguna observación NA

plot_NA <- aggr(datos_completos, col=c('lightblue','red'), numbers=TRUE,
                  sortVars=TRUE, labels=names(datos),
                  cex.axis=.3,
                  gap=3, ylab=c("Histogram of missing data","Pattern"))

## 
##  Variables sorted by number of missings: 
##        Variable Count
##         nnights     0
##         nadults     0
##       nchildren     0
##        planning     0
##             sex     0
##             age     0
##       education     0
##          income     0
##          region     0
##        shopping     0
##       antiquing     0
##         scenery     0
##         eatfine     0
##       eatcasual     0
##     eatfamstyle     0
##     eatfastfood     0
##         museums     0
##      indoorpool     0
##     outdoorpool     0
##          hiking     0
##        gambling     0
##        boatswim     0
##         fishing     0
##         golfing     0
##       boattours     0
##       rideducks     0
##       amusepark     0
##        minigolf     0
##       gocarting     0
##       waterpark     0
##     circusworld     0
##       tbskishow     0
##      helicopter     0
##       horseride     0
##       standrock     0
##      outattract     0
##   nearbyattract     0
##    movietheater     0
##  concerttheater     0
##     barpubdance     0
##    shopbroadway     0
##   bungeejumping     0

Con ello ya estaría solucionado el problema.

Análisis del conjunto de datos

El principal problema que atañe a esta base de datos es que todas las variables son categóricas y podrían considerarse como factores por lo que la parte descriptiva usual que se utilizaría en un dataset con datos numéricos no se puede utilizar.

Puede ser interesante comprender primero cuáles son las características del público por separado (es decir, edades, hijos, etc.) y luego ver cómo se identifican con las atracciones que visitan. Comenzamos con lo primero.

Una buena técnica es ver cuántos visitantes para cada uno de los distintos niveles de los factores hay en cada variable, por ejemplo, cuál es el número de noches o el número de hijos más frecuente

nnights<-table(datos_completos$nnights)
nnights<-prop.table(nnights)
nnights<-as.data.frame(nnights)
names(nnights)<-c("Noches", "Porcentaje")

ggplot(data=nnights, mapping=aes(x=Noches, y=Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Noches que pasan los visitantes",
    subtitle="Porcentaje de personas para 0, 1, 2, 3 o 4+ noches",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Noches, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

la mayoría de los visitantes pasan el día en el parque y luego vuelven o bien pasan más de 2 noches siendo más de 4 no tan frecuente

nadults<-table(datos_completos$nadults)
nadults<-prop.table(nadults)
nadults<-as.data.frame(nadults)
names(nadults)<-c("Adultos", "Porcentaje")

ggplot(data=nadults, mapping=aes(x=Adultos, y=Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Grupos que visitan el parque",
    subtitle="Número de personas en cada grupo",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Adultos, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Aquí podemos comprobar que de la muestra, la mayoría de la gente va en pareja o en grupos de 2 personas siendo tan infrecuente ir en solitario como en grupo de más de 5 siendo los siguientes más frecuentes 1 o 3.

nchildren<-table(datos_completos$nchildren)
nchildren<-prop.table(nchildren)
nchildren<-as.data.frame(nchildren)
names(nchildren)<-c("Hijos", "Porcentaje")

ggplot(data=nchildren, mapping=aes(x=Hijos, y=Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Hijos por visitante",
    subtitle="Número de hijos por visitante",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Hijos, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Los clientes que van suelen tener ningún o 2 hijos y las familias numerosas no suelen ser habituales, lo que es lógico por el precio y las dificultades en el control de los hijos.

planning<-table(datos_completos$planning)
planning<-prop.table(planning)
planning<-as.data.frame(planning)
names(planning)<-c("Planes", "Porcentaje")

ggplot(data=planning, mapping=aes(x=Planes, y=Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Planificación por visitante",
    subtitle="Con cuánta antelación se ha planificado la visita",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Planes, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Respecto a la planificación, más de la mitad de los visitantes, planifican la visita con más de 1 mes de antelación o en la misma semana enla que acuden pero pocas en el mismo mes. Esto puede deberse al aprovechamiento de ofertas de última hora

sex<-table(datos_completos$sex)
sex<-prop.table(sex)
sex<-as.data.frame(sex)
names(sex)<-c("Sexo", "Porcentaje")

ggplot(data=sex, mapping=aes(x=Sexo,Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Sexo de los visitantes",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Sexo, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

En cuanto al sexo, más de la mitad de los visitantes son mujeres.

age<-table(datos_completos$age)
age<-prop.table(age)
age<-as.data.frame(age)
names(age)<-c("Edad", "Porcentaje")

ggplot(data=age, mapping=aes(x=Edad,Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Distribución por edades",
    subtitle="Franjas de edades de los visitantes",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Edad, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Por edades, el pico de gente (50%) que suele acudir es de mediana edad entre 35-44 años o entre 25 y 34 años pues es un parque enfocado a pasar el día en familia.

education<-table(datos_completos$education)
education<-prop.table(education)
education<-as.data.frame(education)
names(education)<-c("Educacion", "Porcentaje")

ggplot(data=education, mapping=aes(x=Educacion,Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Nivel de educación",
    subtitle="Educación más alta completada por cada visitante",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Educacion, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

En el nivel de educación no hay ningún predominio claro, más bien se asemeja a la realidad, es decir, el número de personas con niveles más altos de educación es menos frecuente que personas con un nivel medio o sin ella.

income<-table(datos_completos$income)
income<-prop.table(income)
income<-as.data.frame(income)
names(income)<-c("Ingresos", "Porcentaje")

ggplot(data=income, mapping=aes(x=Ingresos,Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Nivel de ingresos",
    subtitle="Nivel de ingresos por visitante",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Ingresos, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Curiosamente la mayoría de visitantes posee bajos ingresos, con medios ingresos caen y de altos ingresos casi no hay visitantes. Esto es lo que suele ocurrir porque la gente de ingresos muy altos suele acudir a otro tipo de actos recreativos y a que su número no suele ser abundante en la sociedad, un aspecto a tener en cuenta en cuestiones de marketing.

region<-table(datos_completos$region)
region<-prop.table(region)
region<-as.data.frame(region)
names(region)<-c("Region", "Porcentaje")

ggplot(data=region, mapping=aes(x=Region,Porcentaje)) + 
  geom_col(fill="blue", alpha=0.5) +
  scale_y_continuous(label=percent) +
  labs(title="Visitantes según regiones",
    subtitle="Regiones de donde proceden los visitantes",
    x="", y="") +
  theme_bw() + 
  theme(title=element_text(size=14), axis.text=element_text(size=12)) +
  theme(panel.grid.major.x = element_blank()) +
  geom_text(mapping=aes(x=Region, y=Porcentaje,
                        label=percent(Porcentaje)), size=5, nudge_y=0.03)

Por regiones las personas que más acuden al parque con un 31% en total son las de Chicago seguidas de Milwaukee y de otras regiones. El parque se encuentra a 3 horas más o menos de Chicago que es el principal núcleo de población más cercano y de ahí la diferencia respecto a otras regiones

Finalmente, vemos la información relativa a las atracciones que han probado los clientes

yes_no_datos<-as.data.frame(apply(datos_completos[,c(10:42)], 2, table))
head(yes_no_datos)

Como resulta más efectivo organizarla al revés, trasponemos el data frame para usarla posteriormente

yes_no_datos_df<-yes_no_datos %>% t() %>% as.data.frame()
head(yes_no_datos_df)

Para visualizar más claramente la cantidad de YES y NO en todas las variables, separo en 3 tramos las representaciones. Estas son las 10 primeras desde Antigüedades hasta Compras

ggplot(gather(as.data.frame(datos_completos[,c(10:20)])), aes(value)) +
          geom_bar() + 
          facet_wrap(~key, scales = 'free')+
          theme_classic()+
          labs(title="Personas que prueban o no las atracciones",
            x="Respuesta", y="Nº de personas")

Las siguientes 11 (desde parque de atracciones hasta parque acuático)

ggplot(gather(as.data.frame(datos_completos[,c(21:32)])), aes(value)) +
          geom_bar() + 
          facet_wrap(~key, scales = 'free')+
          theme_classic()+
          labs(title="Personas que prueban o no las atracciones",
            x="Respuesta", y="Nº de personas")

Y las últimas 9 desde el pub hasta la standrock

ggplot(gather(as.data.frame(datos_completos[,c(32:42)])), aes(value)) +
          geom_bar() + 
          facet_wrap(~key, scales = 'free')+
          theme_classic()+
          labs(title="Personas que prueban o no las atracciones",
            x="Respuesta", y="Nº de personas")

Y ahora podemos comprobar cuáles son las atracciones que menos gustan a los clientes de la muestra (aquellas donde el número de NO es mayor al de YES) así como las que más

dislike<-yes_no_datos_df %>% filter(NO>YES) %>% arrange(desc(NO))
like<-yes_no_datos_df %>% filter(NO<YES) %>% arrange(desc(YES))
head(like,3)
head(dislike,3)

Así comprobamos que las más visitadas entre los clientes son ir de compras, el parque acuático y comprar en BroadWay mientras que las menos demandadas son el salto al vacío, teatro y helicóptero.

En general, aquellas más de acción o de adultos no son muy frecuentadas debido quizá a las visitas con niños o que no tienen un buen atractivo

Análisis con relaciones

Como técnica exploratoria preliminar, se puede usar la visualización que proporciona gmodels a modo de tablas de contingencia en combinación con dscr y crosstab. Por ejemplo, puede ser útil relacionar el número de noches que pasan los visitantes con su nivel de ingresos

CrossTable(datos_completos$nnights,datos_completos$income)
##    Cell Contents 
## |-------------------------|
## |                       N | 
## | Chi-square contribution | 
## |           N / Row Total | 
## |           N / Col Total | 
## |         N / Table Total | 
## |-------------------------|
## 
## ==============================================================================
##                            datos_completos$income
## datos_completos$nnights    Lower Income   Middle Income   Upper Income   Total
## ------------------------------------------------------------------------------
## 0                                   260             118             13     391
##                                   8.458           7.324          4.056        
##                                   0.665           0.302          0.033   0.230
##                                   0.276           0.180          0.133        
##                                   0.153           0.069          0.008        
## ------------------------------------------------------------------------------
## 1                                    97              84             12     193
##                                   0.968           1.164          0.067        
##                                   0.503           0.435          0.062   0.114
##                                   0.103           0.128          0.122        
##                                   0.057           0.049          0.007        
## ------------------------------------------------------------------------------
## 2                                   241             180             25     446
##                                   0.181           0.320          0.021        
##                                   0.540           0.404          0.056   0.263
##                                   0.256           0.274          0.255        
##                                   0.142           0.106          0.015        
## ------------------------------------------------------------------------------
## 3                                   177             162             23     362
##                                   2.875           3.434          0.213        
##                                   0.489           0.448          0.064   0.213
##                                   0.188           0.247          0.235        
##                                   0.104           0.095          0.014        
## ------------------------------------------------------------------------------
## 4+                                  168             113             25     306
##                                   0.022           0.246          3.050        
##                                   0.549           0.369          0.082   0.180
##                                   0.178           0.172          0.255        
##                                   0.099           0.067          0.015        
## ------------------------------------------------------------------------------
## Total                               943             657             98    1698
##                                   0.555           0.387          0.058        
## ==============================================================================

Fijándonos en las filas y columnas vemos que la gente con ingresos mayores suele pasar de 2 a 4 o más días en el parque, la gente de menores ingresos pasa mayoritariamente entre 1 y 3 días y la gente de ingresos medios se encuentra entre ambas franjas.

Con un gráfico

crosstab(datos_completos$nnights,datos_completos$income,
         xlab = "Nivel de ingresos",
         ylab="Número de noches")

##    Cell Contents 
## |-------------------------|
## |                   Count | 
## |-------------------------|
## 
## ==============================================================================
##                            datos_completos$income
## datos_completos$nnights    Lower Income   Middle Income   Upper Income   Total
## ------------------------------------------------------------------------------
## 0                                   260             118             13     391
## ------------------------------------------------------------------------------
## 1                                    97              84             12     193
## ------------------------------------------------------------------------------
## 2                                   241             180             25     446
## ------------------------------------------------------------------------------
## 3                                   177             162             23     362
## ------------------------------------------------------------------------------
## 4+                                  168             113             25     306
## ------------------------------------------------------------------------------
## Total                               943             657             98    1698
## ==============================================================================

También podemos ver cuál es el número de adultos que acuden en función de la region

CrossTable(datos_completos$region,datos_completos$nadults)
##    Cell Contents 
## |-------------------------|
## |                       N | 
## | Chi-square contribution | 
## |           N / Row Total | 
## |           N / Col Total | 
## |         N / Table Total | 
## |-------------------------|
## 
## =======================================================================
##                           datos_completos$nadults
## datos_completos$region        1       2       3       4      5+   Total
## -----------------------------------------------------------------------
## Chicago                      35     328      73      47      52     535
##                           2.765   0.030   1.375   0.538   2.606        
##                           0.065   0.613   0.136   0.088   0.097   0.315
##                           0.238   0.312   0.361   0.283   0.394        
##                           0.021   0.193   0.043   0.028   0.031        
## -----------------------------------------------------------------------
## Madison                      36     170      32      23      13     274
##                           6.356   0.001   0.011   0.535   3.234        
##                           0.131   0.620   0.117   0.084   0.047   0.161
##                           0.245   0.162   0.158   0.139   0.098        
##                           0.021   0.100   0.019   0.014   0.008        
## -----------------------------------------------------------------------
## Milwaukee                    29     162      39      36      17     283
##                           0.827   0.990   0.845   2.510   1.136        
##                           0.102   0.572   0.138   0.127   0.060   0.167
##                           0.197   0.154   0.193   0.217   0.129        
##                           0.017   0.095   0.023   0.021   0.010        
## -----------------------------------------------------------------------
## Minneapolis/StPaul           14      68      11      12       1     106
##                           2.535   0.087   0.206   0.259   6.362        
##                           0.132   0.642   0.104   0.113   0.009   0.062
##                           0.095   0.065   0.054   0.072   0.008        
##                           0.008   0.040   0.006   0.007   0.001        
## -----------------------------------------------------------------------
## Other                        16     206      35      30      34     321
##                           5.002   0.269   0.266   0.061   3.279        
##                           0.050   0.642   0.109   0.093   0.106   0.189
##                           0.109   0.196   0.173   0.181   0.258        
##                           0.009   0.121   0.021   0.018   0.020        
## -----------------------------------------------------------------------
## Other Wisconsin              17     117      12      18      15     179
##                           0.146   0.348   4.057   0.014   0.085        
##                           0.095   0.654   0.067   0.101   0.084   0.105
##                           0.116   0.111   0.059   0.108   0.114        
##                           0.010   0.069   0.007   0.011   0.009        
## -----------------------------------------------------------------------
## Total                       147    1051     202     166     132    1698
##                           0.087   0.619   0.119   0.098   0.078        
## =======================================================================
crosstab(datos_completos$region,datos_completos$nadults,
         xlab="Número de adultos",
         ylab="Region")

##    Cell Contents 
## |-------------------------|
## |                   Count | 
## |-------------------------|
## 
## ==============================================================
##                           datos_completos$nadults
## datos_completos$region      1      2     3     4    5+   Total
## --------------------------------------------------------------
## Chicago                    35    328    73    47    52     535
## --------------------------------------------------------------
## Madison                    36    170    32    23    13     274
## --------------------------------------------------------------
## Milwaukee                  29    162    39    36    17     283
## --------------------------------------------------------------
## Minneapolis/StPaul         14     68    11    12     1     106
## --------------------------------------------------------------
## Other                      16    206    35    30    34     321
## --------------------------------------------------------------
## Other Wisconsin            17    117    12    18    15     179
## --------------------------------------------------------------
## Total                     147   1051   202   166   132    1698
## ==============================================================

Pero la mejor herramienta para observar relaciones entre todo este conjunto de variables es usando un análisis de correspondencias múltiple MCA. Primero vemos el número de categorías que hay en cada variable

categorias<-apply(datos_completos[,c(1:9)], 2, function(x) nlevels(as.factor(x)))

Ahora aplicamos la función de MCA

mca1<-MCA(datos_completos[,c(1:9)], graph = FALSE)
fviz_eig(mca1)

Con ello podemos comprobar que, al haber tantas variables, la que más varianza es capaz de recoger es la componente 1 con tan sólo el 6% de la total por lo que sólo podemos tomar esto para hacernos una idea general.

Para visualizar

mca1_vars_df = data.frame(mca1$var$coord, Variable = rep(names(categorias), categorias))

# data frame with observation coordinates
mca1_obs_df = data.frame(mca1$ind$coord)

# plot of variable categories
ggplot(data=mca1_vars_df, 
        aes(x = Dim.1, y = Dim.2, label = rownames(mca1_vars_df))) +
        geom_hline(yintercept = 0, colour = "gray70") +
        geom_vline(xintercept = 0, colour = "gray70") +
        geom_text(aes(colour=Variable)) +
        ggtitle("MCA plot of variables using R package FactoMineR")+
        xlim(-1.5,2)

Donde de manera rápida puede verse que los valores alejados del punto central son los menos habituales como que haya grupos de más de 5 integrantes, personas mayores de 65 años, gente de altos ingresos o que hayan planificado esta semana el viaje

Repetimos el proceso para hacerlo con las variables relativas a atracciones

categorias2<-apply(datos_completos[,c(10:42)], 2, function(x) nlevels(as.factor(x)))
mca2<-MCA(datos_completos[,c(10:42)], graph = FALSE)
fviz_eig(mca2)

En lo relatvo a las atracciones, a diferencia del caso anterior, sí las primeras componentes sí parecen recoger gran parte de la varianza total.

Para visualizar

mca2_vars_df = data.frame(mca2$var$coord, Variable = rep(names(categorias2), categorias2))

# data frame with observation coordinates
mca2_obs_df = data.frame(mca2$ind$coord)

# plot of variable categories
ggplot(data=mca2_vars_df, 
        aes(x = Dim.1, y = Dim.2, label = rownames(mca2_vars_df))) +
        geom_hline(yintercept = 0, colour = "gray70") +
        geom_vline(xintercept = 0, colour = "gray70") +
        geom_text(aes(colour=Variable)) +
        ggtitle("MCA plot of variables using R package FactoMineR")+
        xlim(-1.5,2)

Con el gráfico, al igual que pasó antes, se visualizan aquellas actividades que suelen ser dejadas de lado por la gente pues es raro que vayan a concerttbeater, movietheater o hiking e igual de extraño que no visiten el amusepark, outdorrpool, etc.

Proseguimos haciendo un MCA de todo el conjunto de datos

mca3<-MCA(datos_completos,graph = F)
fviz_eig(mca3)

De nuevo, las primeras variables consiguen representar algo más de varianza perosigue estando muy lejos de lo que sería el 60% deseable

Representando el biplot

fviz_mca_biplot(mca3,geom.ind = c("point"))

Se ve poco claro así que representamos sólo las diferentes categorías

fviz_mca_var(mca3)

Se puede comprobar la gran influencia que tienen las respuestas sí y no y apreciar las atracciones deonde más personas acuden y las menos populares a la vez que se combina con las características de cada encuestado.

plotellipses(mca3,keepvar=c(10:42),magnify = 1)

Con este gráfico también de FactoMiner podemos comprobar de nuevo la distribución entre YES y NO de las distintas atracciones siendo el rosa la gente que las ha probado

Es de mucha utilidad relacionar características y atracciones visitadas por lo que iremos comprobando cómo se influyen mediante sucesivos gráficos para cada característica

grp1 <- as.factor(datos_completos[, 1])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp1,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nnights")

Las conclusiones que podemos sacar de este gráfico son claras: las personas que pasan un menor número de noches en el parque no visitan las atracciones que, por lo general, son bien recibidas por la gente y se concentran sobre todo en aquellas atracciones no visitadas (por falta de tiempo). A mayor número de noches, la gente va probando todas las atracciones y pasan a usar aquellas que normalmente no se visitan como concertbeatter, moviethatre, etc.

grp2 <- as.factor(datos_completos[, 2])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp2,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nadults")

En cuanto al número de adultos, no parece influir en la visita a las atracciones pues todos están repartidos uniformemente

grp3 <- as.factor(datos_completos[, 3])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp3,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

Respecto al número de hijos, se aprecia claramente que aquellas personas sin ellos hacen actividades más alejadas de lo usual (normalmente no visitando aquellas a las que todo el mundo va como waterpark o eatfastfoo) y esto demuestra que se acude a las atracciones de siempre o se dejan de visitar por la presencia de hijos.

grp4 <- as.factor(datos_completos[, 4])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp4,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

La planificación también es un condicionante respecto a las atracciones que se visitan pues la gente que ha preparado con más antelación está mucho más presente en aquellos puntos que representan un YES y concentradas también en lo considerado como habitual (el centro del biplot)

grp5 <- as.factor(datos_completos[, 5])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp5,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

En cuanto al género hay una distribución bastante unforme de nuevo y lo único reseñable es el predominio de mujeres

grp6 <- as.factor(datos_completos[, 6])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp6,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

En la edad también se distinguen agrupaciones como el que las personas más mayores tienden a no visitar las atracciones más queridas o que los jóvenes menores de 25 años tienden a probar más todas las que pueden, concentrándose el resto de franjas de edades en la zona más central

grp7 <- as.factor(datos_completos[, 7])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp7,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

El nivel de educación, como es esperable, no es de relevancia a la hora de distinguir grupos

grp8 <- as.factor(datos_completos[, 8])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp8,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

Los ingresos no son algo influyente tampoco en la visita a las atracciones siendo únicamente destacable que la gente de ingresos medios parece estar más centrada en la visita y la no visita a lo habitual

grp9 <- as.factor(datos_completos[, 9])
fviz_mca_biplot(mca2, geom.ind = c("point"),
                habillage=grp9,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")

Para terminar, la región de procedencia tampoco es relevante.

Podemos concluir que lo que condiciona la visita a las atracciones no son factores generales de la gente (como estatus o procedencia) sino temas más tangibles como la compañía con la que se acude, la planificación o la propia edad. Hay atracciones que pueden ser buenas pero por el público que acude (mayoritariamente familiar o parejas) no triunfan y se recurre a otras más propias para niños (cuando se va con ellos)

grp11 <- as.factor(datos_completos[, 2])
fviz_mca_biplot(mca3, geom.ind = c("point"),
                habillage=grp11,labelsize=4,col.var="black",
                pointsize=3,
                legend.title="Nchildren")